home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus 1996 #3
/
Amiga Plus CD - 1996 - No. 3.iso
/
demo-versionen
/
databaseprofessional_v3.0
/
clipart
/
clipbase.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1995-08-11
|
4KB
|
173 lines
/* ClipBase, Clipverwaltung mit DataBase Professional, 11.08.95, Jörg Richter */
OPTIONS RESULTS
RenderScreen = "Amiga 167936 640 256 4"
/* dispID x y colors */
DIAsize = 120 /* Vorschaugröße */
TempDefaults = "T:ADPro.defaults"
NL = D2C(10)
device = "CON:0/0/640/200/ERRORS/WAIT/CLOSE/SCREENDataBase"
ADDRESS DataBase DBTOFRONT
ADDRESS COMMAND
'C:Requestfile > ENV:picpath DRAWERSONLY TITLE="Quellpfad der Bilder" NOICONS PUBSCREEN DataBase'
IF RC = 0 THEN DO
'C:Requestfile > ENV:thumb DRAWER DBPRO:ClipArt DRAWERSONLY TITLE="Pfad für Vorschaubilder" NOICONS PUBSCREEN DataBase'
IF RC = 0 THEN DO
'Echo > ENV:thumbpath $thumb'
'Echo > ENV:source $picpath'
ADDRESS DataBase Message "Erzeuge Verzeichnisstruktur für Vorschaubilder ..."
'List > T:script $picpath dirs all lformat="$source %p%n $thumbpath"'
CALL MakeDirs
ADDRESS DataBase Message "Scanne Quellpfad der Bilder ..."
'List > T:script $picpath P=~(#?.info) files all lformat="$thumbpath $source %p%n %l"'
ADDRESS DataBase
Request "_IFF|_GIF|_Abbruch" "*** ADPro starten ***" || NL || NL || "Format für die Vorschaubilder ?"
IF RC > 0 THEN DO
IF RC = 1 THEN
saveop = "IFF"
ELSE
saveop = "GIF"
CALL PicBase
END
ADDRESS COMMAND
'C:Delete > NIL: T:script'
END
END
EXIT
MakeDirs:
ok = Open(file,'ENV:thumbpath',R)
dest = ReadLn(file)
'C:MakeDir > NIL: ' || LEFT(dest,Length(dest)-1)
ok = Close(file)
ok = Open(file,"T:script",R)
IF ok THEN DO
weiter = 0
DO WHILE weiter = 0
str = ReadLn(file)
IF Length(str) > 0 THEN DO
PARSE VAR str source dir dest .
dir = DelStr(dir,1,Length(source))
'C:MakeDir > NIL: ' dest || dir
END
weiter = EOF(file)
END
ok = Close(file)
END
RETURN
PicBase:
weiter = 0
DO WHILE weiter = 0
weiter = Show('P','ADPro')
IF weiter = 0 THEN DO
ADDRESS DataBase
Request "_Gestartet|_Abbruch" "Bitte ADPro starten ..."
IF RC = 0 THEN EXIT
ADDRESS
END
END
ok = Open(file,"T:script",R)
IF ok THEN DO
ADDRESS "ADPro" SAVE_DEFAULTS TempDefaults
ok = Open(out,device,W)
cnt = WriteLn(out,"Start : " || TIME())
reset = TIME(r)
weiter = 0
DO WHILE weiter = 0
str = ReadLn(file)
IF Length(str) > 0 THEN
CALL CreateThumb
weiter = EOF(file)
END
ok = Close(file)
ADDRESS "ADPro" LOAD_DEFAULTS TempDefaults
cnt = WriteLn(out,"Finish: " || TIME())
cnt = WriteLn(out,D2C(10) || "Convertion time (s): " || TIME(e))
ok = Close(out)
END
RETURN
CreateThumb:
PARSE VAR str path source bild length .
/*
path = Pfad für das erzeugte Thumbnail
source = Quellpfad der Bilder
bild = Pfad und Name des eigentlichenen Bildes
length = Dateilänge des Bildes
*/
IF RIGHT(path,1) ~= "/" THEN DO
IF RIGHT(path,1) ~= ":" THEN
path = path || "/"
END
path = path || DelStr(bild,1,Length(source))
pos = MAX(LastPos("/",bild),LastPos(":",bild))+1
bildname = SubStr(bild,pos,Length(bild)-pos+1) /* Bildname ermitteln */
pos = LastPos(".",bildname)
IF pos > 0 THEN
bildname = LEFT(bildname,pos) || saveop
path = SubStr(path,1,Length(path)-Length(bildname))
IF Exists(path || bildname) = 1 THEN /* Falls Thumbnail schon existiert */
RETURN /* weiter mit nächsten Bild */
ADDRESS DataBase Message "Bearbeite " || bild || " ..."
ADDRESS "ADPro"
PSTATUS "LOCKED"
DITHER 1
LOADER "UNIVERSAL" bild
IF RC ~= 0 THEN DO
cnt = WriteLn(out,"Loading error: " || bild)
RETURN
END
XSIZE
width = ADPRO_RESULT
YSIZE
height = ADPRO_RESULT
IF width > height THEN DO
yy = (height/width) * DIAsize
xx = DIAsize
END
ELSE DO
xx = (width/height) * DIAsize
yy = DIAsize
END
ABS_SCALE xx yy
SET_RENDER_MODE RenderScreen
EXECUTE
SAVER saveop path || bildname "IMAGE"
IF RC ~= 0 THEN DO
cnt = WriteLn(out,"Saving error : " || path || bildname)
RETURN
END
ADDRESS DataBase
Add
PutData $F1 bild
PutData $F2 length
PutData $F3 width || "x" || height
IF Compare(LEFT(path,6),"DBPRO:") = 0 THEN path = DelStr(path,1,6)
PutData $F4 path || bildname
RETURN